home *** CD-ROM | disk | FTP | other *** search
/ MacWorld 1999 March - Disc 1 / Macworld (1999-03) (Disk 1).dmg / Shareware World / Utilities / Text Processing / Alpha / Tcl / Modes / bibtexMode.tcl < prev    next >
Encoding:
Text File  |  1998-08-25  |  52.0 KB  |  1,788 lines  |  [TEXT/ALFA]
  1. ## -*-Tcl-*-
  2.  # ###################################################################
  3.  #  Vince's Additions - an extension package for Alpha
  4.  # 
  5.  #  FILE: "bibtexMode.tcl"
  6.  #                                    created: 17/8/94 {9:12:06 am} 
  7.  #                                last update: 25/8/98 {12:24:58 am} 
  8.  #  Updated by: Vince Darley
  9.  #  E-mail: <darley@fas.harvard.edu>
  10.  #    mail: Division of Engineering and Applied Sciences, Harvard University
  11.  #          Oxford Street, Cambridge MA 02138, USA
  12.  #     www: <http://www.fas.harvard.edu/~darley/>
  13.  #  
  14.  # Major rewrite of most of BibTeX mode.  Original by Tom Pollard.
  15.  # See the end of the BibTeX Help file for a history.
  16.  # 
  17.  # ###################################################################
  18.  ##
  19.  
  20. alpha::mode Bib 3.3 bibtexMenu {*.bib *.inspec *.bst *.hollis *.isi} { 
  21.     texMenu bibtexMenu electricReturn electricTab
  22. } {
  23.     addMenu bibtexMenu "•282" Bib
  24.     alpha::package require prompts
  25. } uninstall {this-file} help {file "BibTeX Help"}
  26. # to make sure tex-mode is loaded
  27. texMenu
  28.  
  29. newPref v bibAutoIndex 1 Bib "" [list "Never make index" \
  30.   "Ask user when it is necessary" "Always remake when necessary"] index
  31.  
  32. newPref v suffixString    { \\\\} Bib
  33. newPref v prefixString {% } Bib
  34. newPref v fillColumn {65} Bib
  35. newPref f wordWrap {1} Bib
  36. newPref f autoMark {1} Bib
  37.  
  38. ###########################################################################
  39. # Search patterns for entries and cite-keys
  40. #
  41. #     set bibTopPat {^[     ]*@[a-zA-Z]+[\{\(]([-A-Za-z0-9_:/\.]+)}
  42. # match entry type
  43. set bibTopPat {^[     ]*@([a-zA-Z]+)[\{\(]}
  44. # match cite-key
  45. set bibTopPat1 {^[     ]*@[a-zA-Z]+[\{\(][     ]*([^=,     ]+)}    
  46. # match type and cite-key
  47. set bibTopPat2 {^[     ]*@([a-zA-Z]+)[\{\(][     ]*([^=,     ]+)}    
  48. # match first field (no cite-key)
  49. set bibTopPat3 {^[     ]*@([a-zA-Z]+)[\{\(]([     ]*[a-zA-Z]+[     ]*=[     ]*)}    
  50.  
  51. newPref v wordBreak {[a-zA-Z0-9]+} Bib
  52. newPref v wordBreakPreface {[^a-zA-Z0-9]} Bib
  53. newPref v funcExpr $bibTopPat Bib
  54.  
  55. newPref f overwriteBuffer {1} Bib
  56. newPref f fieldBraces {1} Bib
  57. newPref f entryBraces {1} Bib
  58. newPref f segregateStrings {1} Bib
  59. newPref f markStrings {0} Bib
  60. newPref f alignEquals {0} Bib
  61. newPref f zapEmptyFields {0} Bib
  62. newPref f descendingYears {1} Bib
  63. newPref v indentString {   } Bib
  64. newPref v stdAbbrevs {jan feb mar apr may jun jul aug sep oct nov dec} Bib
  65.  
  66. # ◊◊◊◊ Option-click title bar ◊◊◊◊ #
  67. # use TeX routines for Bib mode
  68. proc Bib::OptionTitlebar {} {TeX::OptionTitlebar}
  69. proc Bib::OptionTitlebarSelect {item} {TeX::OptionTitlebarSelect $item}
  70.  
  71. ###########################################################################
  72. # BibTeX Key Bindings.
  73. ###########################################################################
  74. # abbreviations:  <o> = option, <z> = control, <s> = shift, <c> = command
  75. #
  76. Bind 'b' <sz>    selectEntry "Bib"
  77. Bind 'n' <sz>    nextEntry "Bib"
  78. Bind 'p' <sz>    prevEntry "Bib"
  79.  
  80. Bind 'f' <sz>    searchFields "Bib"
  81. Bind 'm' <sz>    searchEntries "Bib"
  82. Bind 'l' <sz>    formatEntry "Bib"
  83.  
  84. ###########################################################################
  85. # Data Definitions
  86. ###########################################################################
  87. ###########################################################################
  88. # Define the data arrays that contain the names of the required,
  89. # optional, and preferred fields for each entry type.
  90. #
  91. # The index names of the rqdFld() array _define_ the valid entry types
  92. # recognized by the program.
  93. #
  94. set rqdFld(article) {author title journal year} 
  95. set optFld(article) {volume number pages month note}
  96. set myFld(article) {author title journal volume pages year note} 
  97.  
  98. set rqdFld(book) {author title publisher year} 
  99. set optFld(book) {editor volume number series address edition month note}
  100.  
  101. set rqdFld(booklet) {title} 
  102. set optFld(booklet) {author howpublished address month year note}
  103.  
  104. set rqdFld(conference) {author title booktitle year} 
  105. set optFld(conference) {editor volume number series pages organization publisher address month note}
  106.  
  107. set rqdFld(inBook) {author title chapter publisher year} 
  108. set optFld(inBook) {editor pages volume number series address edition month type note}
  109.  
  110. set rqdFld(inCollection) {author title booktitle publisher year} 
  111. set optFld(inCollection) {editor volume number series type chapter pages address edition month note}
  112.  
  113. set rqdFld(inProceedings) {author title booktitle year} 
  114. set optFld(inProceedings) {editor volume number series pages organization publisher address month note}
  115.  
  116. set rqdFld(manual) {title} 
  117. set optFld(manual) {author organization address edition year month note}
  118.  
  119. set rqdFld(mastersThesis) {author title school year} 
  120. set optFld(mastersThesis) {address month note type}
  121.  
  122. set rqdFld(misc) {} 
  123. set optFld(misc) {author title howpublished year month note}
  124.  
  125. set rqdFld(phdThesis) {author title school year} 
  126. set optFld(phdThesis) {address month type note}
  127.  
  128. set rqdFld(proceedings) {title year} 
  129. set optFld(proceedings) {editor volume number series publisher organization address month note}
  130.  
  131. set rqdFld(techReport) {author title institution year} 
  132. set optFld(techReport) {type number address month note}
  133.  
  134. set rqdFld(unpublished) {author title note} 
  135. set optFld(unpublished) {year month}
  136.  
  137. set entryNames [lsort [array names rqdFld]]
  138. set customEntries [lsort [array names myFld]]
  139.  
  140. ###########################################################################
  141. # Define an array of flags indicating whether the data a given field
  142. # type should be quoted.  The actual characters used to quote the field are
  143. # given by $bibOpenQuote and $bibCloseQuote, which are set by the routine
  144. # 'bibFieldDelims' according to the flag $fieldBraces.
  145. #
  146. # Note that the index names of the useBrace() array _define_ the valid 
  147. # field types recognized by the program.
  148. #
  149. array set useBrace {
  150.     address 1
  151.     annote 1
  152.     author 1
  153.     booktitle 1
  154.     chapter 0
  155.     crossref 1
  156.     edition 1
  157.     editor 1
  158.     howpublished 1
  159.     institution 1
  160.     journal 1
  161.     key 1
  162.     language 1
  163.     month 1
  164.     note 1
  165.     number 0
  166.     organization 1
  167.     pages 1
  168.     publisher 1
  169.     school 1
  170.     series 1
  171.     title 1
  172.     type 1
  173.     volume 0
  174.     year 0
  175.     isbn 1
  176.     customField 1
  177.     city 1
  178. }
  179.  
  180. set fieldNames [lsort [array names useBrace]]
  181. ###########################################################################
  182. # Default values for newly created fields
  183. #
  184. set defFldVal(language) "german"
  185.  
  186. set fieldDefs [lsort [array names defFldVal]]
  187.  
  188. ###########################################################################
  189. # BibTeX-mode mode definition
  190. ###########################################################################
  191.  
  192. set bibtexKeyWords $fieldNames
  193. regModeKeywords -e {%} -m {@} -c red -k blue Bib $bibtexKeyWords
  194. unset bibtexKeyWords
  195.  
  196. ###########################################################################
  197. # BibTeX Menu Definition.
  198. ###########################################################################
  199. proc bibtexMenu {} {}
  200.  
  201. proc bibtex {} {
  202.     global bibtexSig
  203.     set name [app::launchAnyOfThese {BIBt Vbib CMTu} bibtexSig]
  204.     switchTo [file tail $name]
  205. }
  206.  
  207. menu::buildProc bibtexMenu Bib::buildBibMenu
  208.  
  209. proc Bib::buildBibMenu {} {
  210.     global bibtexMenu
  211.     return [list "build" \
  212.       [list "/-<U<Obibtex" "(-)" \
  213.       [list Menu -n Entries -p makeEntry {}] \
  214.       [list Menu -n Fields -p makeField {}] \
  215.       "(-)" \
  216.       "/B<U<BselectEntry" "/N<U<BnextEntry" "/P<U<BprevEntry" \
  217.       "/L<U<BformatEntry" "/C<U<BcopyCiteKey" \
  218.       "(-)" \
  219.       "/M<U<BsearchEntries" "/F<U<BsearchFields" \
  220.       {Menu -n sortBy... -p bibSortProc {
  221.           "citeKey"
  222.           "firstAuthor,Year"
  223.           "lastAuthor,Year"
  224.           "year,FirstAuthor"
  225.           "year,LastAuthor"
  226.           }
  227.       } \
  228.       {Menu -n sortMarks... -p markSortProc {
  229.           "alphabetically"
  230.           "byPosition"
  231.           }
  232.       } \
  233.       "(-)" \
  234.       "countEntries" "formatAllEntries" \
  235.       "/Q<IquickFindCitation" \
  236.       "/A<U<BaddWinToDatabase" \
  237.       "/I<U<IindexOfThisWindow" \
  238.       "(-)" \
  239.       "rebuildIndex" \
  240.       "rebuildDatabase"] \
  241.       Bib::menuProc \
  242.       [list Entries Fields] \
  243.       $bibtexMenu]
  244. }
  245.  
  246. proc Bib::menuProc {menu item} { 
  247.     set menu Bib
  248.     if {[info commands ${menu}::${item}] != ""} {
  249.         uplevel \#0 ${menu}::$item
  250.     } elseif {[info commands $item] != ""} {
  251.         uplevel \#0 $item
  252.     } elseif {[catch {${menu}::$item}]} {
  253.         if {[info commands ${menu}::$item] == ""} {
  254.             uplevel \#0 $item
  255.         }
  256.     }
  257. }
  258.  
  259. proc Bib::quickFindCitation {} {
  260.     Bib::GotoEntry [prompt::statusLineComplete "Citation" Bib::completionsForEntry \
  261.       -preeval {source [file join $PREFS bibIndex]} -posteval {unset bibIndex}]
  262. }
  263.  
  264. proc Bib::completionsForEntry {pref} {
  265.     Bib::_FindAllEntries $pref 0
  266. }
  267. set menu::items(Entries) [concat $entryNames "(-)" "customEntry"]
  268. set menu::proc(Entries) makeEntry
  269. set menu::items(Fields) [concat $fieldNames "(-)" "customField" "multipleFields"]
  270. set menu::proc(Fields) makeField
  271.  
  272. menu::buildSome bibtexMenu
  273.  
  274. ## 
  275.  # -------------------------------------------------------------------------
  276.  #   
  277.  # "Bib::openFile" --
  278.  #  
  279.  #  Given a filename, and the directory of the base '.aux' file, try and
  280.  #  find the file.  If we don't succeed, pass the request onto the TeX
  281.  #  code.
  282.  # -------------------------------------------------------------------------
  283.  ##
  284. proc Bib::openFile {filename {dir ""}} {
  285.     # look where base file was
  286.     if {![catch {file::openQuietly [file join ${dir} ${filename}]}]} {
  287.         return
  288.     }
  289.     # look in bibtex inputs folder
  290.     global bibtexSig
  291.     if {![catch {file::openQuietly [file join [file dirname [nameFromAppl $bibtexSig]] "BibTeX inputs" ${filename}]}]} {
  292.         return
  293.     } 
  294.     # look in all usual tex places
  295.     openTeXFile "$filename"
  296.     return
  297. }
  298.  
  299. ## 
  300.  # -------------------------------------------------------------------------
  301.  #   
  302.  # "Bib::noEntryExists" --
  303.  #  
  304.  #  No entry exists in the known .bib files.  Either add an entry, possibly
  305.  #  in a new bibliography file, or add a .bib file to those currently
  306.  #  searched.
  307.  # -------------------------------------------------------------------------
  308.  ##
  309. proc Bib::noEntryExists {item {basefile ""}} {
  310.     set basefile [Bib::getBasefile $basefile]
  311.     set choice [dialog::optionMenu \
  312.         "No entry '$item' exists.  What do you want to do?" \
  313.         [list "New entry" "New entry in new bibliography file" \
  314.         "Add .bib file to \\bibliography\{…\}" \
  315.         "Change original citation" \
  316.         "Search all bibliographies" ]]
  317.     switch $choice {
  318.       "New entry" {
  319.           Bib::_newEntry $item
  320.       }
  321.       "New entry in new bibliography file" {
  322.           Bib::_newEntry $item 1
  323.       }
  324.       "Add .bib file to \\bibliography\{…\}" {
  325.           Bib::insertNewBibliography $basefile    
  326.       }
  327.       "Search all bibliographies" {
  328.           alertnote "Not yet implemented"
  329.       }
  330.       "Change original citation" {
  331.           Bib::changeOriginalCitation $item $basefile
  332.       }
  333.       "Cancel" {
  334.           # nothing
  335.       }
  336.       }               
  337. }
  338.  
  339. proc Bib::_newEntry {item {new_file 0}} {
  340.     if $new_file {
  341.         set bibfile [putfile "Save new bibliography as…" ".bib"]
  342.         if {$bibfile == ""} {
  343.             error "No bibliography file selected."
  344.         } else {
  345.             new -n $bibfile
  346.         }        
  347.     } else {
  348.           # need to pick a .bib file
  349.           set bibfile [Bib::pickBibliography 1 \
  350.               "Select a bibliography file to which to add an entry"]
  351.           openTeXFile $bibfile
  352.     }
  353.     global entryNames
  354.     bibFormatSetup
  355.     newEntry [listpick -p "Which type of entry?" $entryNames]
  356.     insertText $item
  357.     ring::+
  358.     
  359. }
  360.  
  361. proc Bib::changeOriginalCitation {citation {basefile ""}} {
  362.       if {$basefile == ""} {set basefile [TeX_currentBaseFile]}
  363.       # find .aux and open base .tex/.ltx
  364.     if {[set proj [isWindowInFileset $basefile "tex"]] != ""} {
  365.         set files [texListFilesInFileSet $proj]
  366.     } else {
  367.         set files $basefile
  368.     }
  369.     set got "[eval grep [list $citation] $files]\r"
  370.     if {[string first "; Line " $got] == [string last "; Line " $got]} {
  371.         # just one match
  372.         if ![regexp {∞([^\r\n]*)[\r\n]} $got dmy filename] {
  373.             alertnote "I couldn't find the original.  You probably have a\
  374.               multi-part document which you haven't made into a TeX fileset.\
  375.               Unless it's a fileset, I can't find the other files."
  376.             return
  377.         }
  378.         file::openQuietly $filename
  379.         eval select [searchInFile $filename $citation 1]
  380.         message "This is the original citation.  Change it, then re-run LaTeX and BibTeX."
  381.     } else {
  382.         grepsToWindow "* List of citations *" $got
  383.     }
  384. }
  385.  
  386. proc Bib::getBasefile {{basefile ""}} {
  387.       if {$basefile == ""} {return [TeX_currentBaseFile]}
  388.       # find .aux and open base .tex/.ltx
  389.       set base [file root $basefile]
  390.       if [file exists ${base}.tex] {
  391.           return ${base}.tex
  392.       } elseif [file exists ${base}.ltx] {
  393.           return ${base}.ltx
  394.       } else {
  395.           alertnote "Base file with name '${base}.tex/ltx' not found." 
  396.         error ""
  397.       }                                   
  398. }
  399.  
  400. proc Bib::insertNewBibliography {{basefile ""} {bibfile ""}} {
  401.       set basefile [Bib::getBasefile $basefile]
  402.       file::openQuietly ${basefile}
  403.       
  404.       # find bibliography, position cursor and add
  405.     pushPosition
  406.       endOfBuffer
  407.       if [catch {set pos [search -s -f 0 -r 0 -m 0 "\\bibliography\{" [getPos]]}] {
  408.           # add the environment
  409.           set pos [search -s -f 0 "\\end\{document\}" [getPos]]
  410.           goto [lindex $pos 0]
  411.           set preinsert "\\bibliography\{"
  412.           set postinsert "\}\r\r"
  413.       } else {
  414.           set preinsert ""
  415.           set postinsert ","
  416.           goto [lindex $pos 1]
  417.       }
  418.       if {$bibfile == ""} {
  419.         set bibfile [Bib::pickBibliography 0 \
  420.             "Select a bibliography file to add"]
  421.     }
  422.       insertText "${preinsert}[lindex [split $bibfile "."] 0]${postinsert}"
  423.     message "press <Ctrl .> to return to original cursor position"
  424. }
  425.  
  426. # Used by Bib::pickBibliography to set a default in the listpick dialog
  427. # It's useful because you will often want to add a bunch of new items
  428. # in a row to the same bibliography.
  429. # NOTE: this is set by my code, not you.
  430. set Bib::_defaultBib ""
  431.  
  432. ## 
  433.  # -------------------------------------------------------------------------
  434.  #     
  435.  # "Bib::pickBibliography" --
  436.  #    
  437.  #    Put    up a list-dialog so    the    user can select    a bibliography file    for
  438.  #    some action    (taken by the caller).    Can    also create    a new file if
  439.  #    desired.
  440.  # -------------------------------------------------------------------------
  441.  ##
  442. proc Bib::pickBibliography {{allowNew 1} {prompt "Pick a bibliography file"}} {
  443.     set biblist [Bib::ListAllBibliographies]
  444.     if $allowNew {
  445.         lappend biblist {New file…}
  446.     }
  447.     global Bib::_defaultBib
  448.     set bibfile [listpick -p $prompt -L ${Bib::_defaultBib} $biblist]
  449.     if {$bibfile == ""} {
  450.         error "No bibliography file selected."
  451.     } elseif {$bibfile == "New file…" } {
  452.         set bibfile [putfile "Save new bibliography as…" ".bib"]
  453.         if {$bibfile == ""} {
  454.             error "No bibliography file selected."
  455.         } else {
  456.             set fout [open $bibfile w]
  457.             close $fout
  458.         }        
  459.     }
  460.     return [file tail [set Bib::_defaultBib $bibfile]]
  461. }
  462.  
  463. ## 
  464.  # -------------------------------------------------------------------------
  465.  #     
  466.  # "Bib::ListAllBibliographies" --
  467.  #    
  468.  #    Return all bibliographies on the search    path.  Optionally only return
  469.  #  those which are in a given .aux file.
  470.  # -------------------------------------------------------------------------
  471.  ##
  472. proc Bib::ListAllBibliographies { {auxfile ""} } {
  473.     TeXEnsureSearchPathSet
  474.     global AllTeXSearchPaths
  475.     set biblist {}
  476.     if {$auxfile == "" || [catch {set fid [open "$auxfile" r]}]} {
  477.         foreach d $AllTeXSearchPaths {
  478.             eval lappend biblist [glob -nocomplain [file join ${d} *.bib]]
  479.         }
  480.     } else {
  481.         set bibs {}
  482.         # get list of bibs from .aux file
  483.         set cid [scancontext create]
  484.         scanmatch $cid {bibdata\{([^\}]*)\}} {
  485.             eval lappend bibs [split $matchInfo(submatch0) ","]
  486.         }
  487.         scanfile $cid $fid
  488.         close $fid
  489.         scancontext delete $cid
  490.         # find the full paths
  491.         foreach b $bibs {
  492.             foreach d $AllTeXSearchPaths {
  493.                 if [file exists [file join ${d} ${b}.bib]] {
  494.                     lappend biblist [file join ${d} ${b}.bib]
  495.                     break
  496.                 }
  497.             }        
  498.         }
  499.     }
  500.     global mode
  501.     if {$mode == "TeX" || $mode == "Bib"} {
  502.         # we should add the current window's path to the search path
  503.         eval lappend biblist \
  504.           [glob -nocomplain [file join [file dirname [win::Current]] *.bib]]
  505.     }    
  506.     return $biblist
  507. }
  508.  
  509. ## 
  510.  # -------------------------------------------------------------------------
  511.  #     
  512.  # "Bib::GotoEntry" --
  513.  #    
  514.  #    Look for a bib entry in    the    given list of files, or    if that    fails or
  515.  #    isn't given, look in all available bib files on    the    search path.
  516.  # -------------------------------------------------------------------------
  517.  ##
  518. proc Bib::GotoEntry {entry {biblist {}}} {
  519.     if ![catch {Bib::gotoEntryFromIndex $entry}] {
  520.         return
  521.     }
  522.     if {[llength $biblist] && ![catch {Bib::_GotoEntry $entry $biblist 0}]} {
  523.         return
  524.     }
  525.     if ![catch {Bib::_GotoEntry $entry [Bib::ListAllBibliographies]}] {
  526.         return
  527.     }
  528.     beep
  529.     error "Can't find entry '$entry' in the .bib file(s)"
  530. }
  531.  
  532. ## 
  533.  # -------------------------------------------------------------------------
  534.  #     
  535.  # "Bib::gotoEntryFromIndex"    --
  536.  #    
  537.  #    Look in    the    bibIndex and find an entry very    quickly.
  538.  # -------------------------------------------------------------------------
  539.  ##
  540. proc Bib::gotoEntryFromIndex {entry} {
  541.     set bibTopPat {@([a-zA-Z]+)[\{\(][     ]*}
  542.     global PREFS
  543.     # if it fails, but we succeed later, we will have the opportunity
  544.     # to rebuild the bibIndex
  545.     if [file exists [file join ${PREFS} bibIndex]] {
  546.     source [file join ${PREFS} bibIndex]
  547.     foreach f [array names bibIndex] {
  548.         if [regexp "\[ \r\n\]$entry\[ \r\n\]" "$bibIndex($f)"] {
  549.         file::openQuietly $f
  550.         set p [search -s -f 1 -r 1 $bibTopPat$entry [minPos]]
  551.         eval select $p
  552.         refresh
  553.         eval select $p
  554.         unset bibIndex
  555.         return
  556.         }
  557.     }
  558.     unset bibIndex
  559.     }
  560.     error "Entry '$entry' not found in bibIndex"
  561. }
  562.  
  563. ## 
  564.  # -------------------------------------------------------------------------
  565.  #     
  566.  # "Bib::_FindAllEntries"    --
  567.  #    
  568.  #    Find all entries with a    given prefix, optionally attaching the titles
  569.  #    of the entries (this requires a    bibDatabase    file to    be setup).    Used
  570.  #    by TeX citation    completions: \cite{Darley<cmd-Tab>
  571.  # -------------------------------------------------------------------------
  572.  ##
  573. proc Bib::_FindAllEntries {eprefix {withtitles 1}} {
  574.     global PREFS 
  575.     set matches {}
  576.     if $withtitles {
  577.         if {![file exists [file join ${PREFS} bibDatabase]]} {
  578.             if {[askyesno "No bibDatabase exists, shall I make one?"]=="yes"} {
  579.                 Bib::rebuildDatabase
  580.             } else {
  581.                 error "No bib database exists"
  582.             }
  583.         }
  584.         set cid [scancontext create]
  585.         scanmatch $cid "^${eprefix}" {
  586.             lappend matches $matchInfo(line)
  587.         }
  588.         set fid [open [file join ${PREFS} bibDatabase] r]
  589.         scanfile $cid $fid
  590.         close $fid
  591.         scancontext delete $cid    
  592.     } else {
  593.         if ![file exists [file join ${PREFS} bibIndex]] {
  594.             if {[askyesno "No bibIndex exists, shall I make one?"]=="yes"} {
  595.                 Bib::rebuildIndex
  596.             } else {
  597.                 error "No bib index exists"
  598.             }
  599.         }
  600.         global bibIndex
  601.         if {![array exists bibIndex]} {
  602.             source [file join ${PREFS} bibIndex]
  603.             set unset 1
  604.         }
  605.         foreach f [array names bibIndex] {
  606.             eval lappend matches [completion::fromList $eprefix "bibIndex(${f})"]
  607.         }
  608.         if {[info exists unset]} {unset bibIndex}
  609.     }
  610.     return $matches    
  611. }
  612.  
  613. ## 
  614.  # -------------------------------------------------------------------------
  615.  #     
  616.  # "Bib::_GotoEntry" --
  617.  #    
  618.  #    Find a bib entry in    one    of the given list of files,    and    signal an
  619.  #    error if the entry isn't found.     I think this is the quickest way.
  620.  # -------------------------------------------------------------------------
  621.  ##
  622. proc Bib::_GotoEntry {entry biblist {rebuild 1}} {
  623.      set bibTopPat {@([a-zA-Z]+)[\{\(][     ]*}
  624.      set cid [scancontext create]
  625.      scanmatch $cid $bibTopPat$entry {
  626.          set found "$matchInfo(offset)"
  627.      }
  628.      set found ""
  629.     foreach f $biblist {
  630.         message "Searching [file tail $f]…"
  631.         if {![catch {set fid [open $f]}]} {
  632.             scanfile $cid $fid
  633.             close $fid
  634.             if {$found != ""} {
  635.                 file::openQuietly $f
  636.                 goto $found
  637.                 refresh
  638.                 select $found [nextLineStart $found]
  639.                 scancontext delete $cid
  640.                 global BibmodeVars
  641.                 # make the index since it was obviously out of date                
  642.                 if {$rebuild == 1 && ($BibmodeVars(bibAutoIndex) == 2 \
  643.                   || [askyesno "The bibIndex seems to be out of date.  Rebuild?"]=="yes")} {
  644.                     Bib::rebuildIndex
  645.                 }
  646.                 return
  647.             }    
  648.         }
  649.     }
  650.     scancontext delete $cid
  651.     error "Entry '$entry' not found."
  652. }
  653.  
  654.  
  655. ## 
  656.  # -------------------------------------------------------------------------
  657.  #     
  658.  # "Bib::rebuildIndex" --
  659.  #    
  660.  #    Build the bibIndex file    which allows for very fast lookup of bib
  661.  #    entries.
  662.  # -------------------------------------------------------------------------
  663.  ##
  664. proc Bib::rebuildIndex {} {
  665.     global PREFS 
  666.     set bibTopPat2 {^[     ]*@([a-zA-Z]+)[\{\(][     ]*([^=,     ]+)}    
  667.      set cid [scancontext create]
  668.      # this will actually mark strings as well
  669.      scanmatch $cid $bibTopPat2 {
  670.          if {![regexp -nocase (preamble|string|comment) $matchInfo(submatch0)]} {
  671.             lappend found $matchInfo(submatch1)
  672.          }
  673.      }
  674.      set bout [open [file join ${PREFS} bibIndex] w]
  675.      puts $bout "# Bibliography index file for quick reference lookup"
  676.      puts $bout "# Created on [mtime [now]]"
  677.     set bibs [lsort [Bib::ListAllBibliographies]]
  678.     set bibl [llength $bibs]
  679.     foreach f $bibs {
  680.         set found {}
  681.         puts $bout "set \"bibIndex($f)\" \{"
  682.         message "Indexing ([incr bibl -1] left) [file tail $f]É"
  683.         if {![catch {set fid [open $f]}]} {
  684.             scanfile $cid $fid
  685.             close $fid
  686.         }
  687.         # we sort so we can search it efficiently for all entries with
  688.         # a given prefix.
  689.         puts $bout " [lsort $found] "
  690.         puts $bout "\}"
  691.     }
  692.     close $bout
  693.     scancontext delete $cid
  694.     message "bibIndex creation complete"
  695. }
  696.  
  697. ## 
  698.  # -------------------------------------------------------------------------
  699.  #     
  700.  # "Bib::rebuildDatabase" --
  701.  #    
  702.  #    Build the bibDatabase which    allows speedy completion of    citations and
  703.  #    contains titles, so    that you can pick the correct completion easily.
  704.  # -------------------------------------------------------------------------
  705.  ##
  706. proc Bib::rebuildDatabase {} {
  707.     global PREFS
  708.     set bdatout [open [file join ${PREFS} bibDatabase] w]
  709.      puts $bdatout "# Bibliography database file for quick reference lookup"
  710.      puts $bdatout "# Created on [mtime [now]]"
  711.     # if it fails, but we succeed later, we will have the opportunity
  712.     # to rebuild the bibIndex
  713.     set bibs [lsort -ignore [Bib::ListAllBibliographies]]
  714.     set bibl [llength $bibs]
  715.     foreach f $bibs {
  716.         file::openQuietly $f
  717.         message "Indexing ([incr bibl -1] left) [file tail $f]…"
  718.         puts $bdatout [Bib::makeDatabaseOf $f]
  719.         killWindow
  720.     }
  721.     close $bdatout
  722. }
  723.  
  724. proc Bib::indexOfThisWindow {{f ""}} {
  725.     if {$f == ""} {
  726.         set f [win::Current]
  727.     }
  728.     file::openQuietly $f
  729.     set ret [Bib::makeDatabaseOf $f]
  730.     new -n "* Index for [file tail $f] *" -m Text
  731.     insertText $ret
  732.     winReadOnly
  733. }
  734.  
  735. proc Bib::addWinToDatabase {{f ""}} {
  736.     if {$f == ""} {
  737.         set f [win::Current]
  738.     }
  739.     global PREFS
  740.     set bdatout [open [file join ${PREFS} bibDatabase] a]
  741.     file::openQuietly $f
  742.     puts $bdatout [Bib::makeDatabaseOf $f]
  743.     close $bdatout
  744. }
  745.  
  746. proc Bib::makeDatabaseOf {f} {
  747.     set bibTopPat {@([a-zA-Z]+)[\{\(][     ]*}
  748.     message "Indexing ${f}…"
  749.     set p [minPos]
  750.     set ret ""
  751.     while {![catch {search -s -f 1 -r 1 -- $bibTopPat $p} epos]} {
  752.     set p [lindex $epos 0]
  753.     set np [nextLineStart $p]
  754.     set entry [getText $p $np]
  755.     regexp {^@([a-zA-Z]+)([\{\(])[     ]*(.*)} $entry "" type brace entry
  756.     if {[regexp -nocase (preamble|string|comment) $type] \
  757.       || [catch {matchIt $brace [pos::math $p + [expr 3 + [string length $type]]]} end]} {
  758.         set p $np
  759.         continue
  760.     }
  761.     set p $end
  762.     if {![catch {search -s -f 1 -r 1 -l $end -- "title\[ \t\]*=\[ \t\]*" $np} epos]} {
  763.         set entry [string trim $entry "\{\( \t\r,"]
  764.         set epos [lindex $epos 1]
  765.         if {[regexp {[\(\{]} [lookAt $epos] brace] \
  766.           && ![catch {matchIt $brace [pos::math $epos + 1]} end] } {
  767.         set title [getText $epos $end]
  768.         } else {
  769.         set title [getText $epos [nextLineStart $epos]]
  770.         }
  771.         regsub -all "\[\{\}\]+" $title {} title
  772.         regsub -all "\[ \n\r\t\]+" $title { } title
  773.         append ret "$entry \{$title\}\r"
  774.     }
  775.     }   
  776.     return $ret
  777. }
  778.  
  779.  
  780. ###########################################################################
  781. # Menu command procs
  782. ###########################################################################
  783.         
  784. proc makeField {menu item} {
  785.     global fieldNames
  786.     bibFormatSetup
  787.     
  788.     if {$item == "multipleFields"} {
  789.     set flds [listpick -l -L {author year} -p "Pick desired fields:" $fieldNames]
  790.     if {[llength flds]} {
  791.         set lines {}
  792.         foreach fld $flds {
  793.         append lines [newField $fld]
  794.         }
  795.     } else {
  796.         return
  797.     }
  798.     } else {
  799.     set lines [newField $item]
  800.     }
  801.     
  802.     set pos0 [nextLineStart [getPos]]
  803.     goto $pos0
  804.     elec::Insertion $lines
  805. }
  806.  
  807. proc makeEntry {menu item} {
  808.     bibFormatSetup
  809.     newEntry $item
  810. }
  811.  
  812. ###########################################################################
  813. #  Return the bounds of the bibliographic entry surrounding the current 
  814. #  position.
  815. #
  816. proc getEntry {pos} {
  817.     
  818.     set pos1 [search -f 0 -r 1 -n -s {[     ]*@[a-zA-Z]*[\{\(]} $pos ]
  819.     if {$pos1 == ""} {
  820.         set begPos [nextLineStart $pos]
  821.         set endPos $begPos
  822.     } else {
  823.         set begPos [lineStart [lindex $pos1 0]]
  824.         set pos0 [lindex $pos1 1]
  825.         set openBrace [getText [pos::math $pos0 - 1] $pos0 ]
  826.         if {[catch {matchIt $openBrace $pos0} pos1]} {
  827.         alertnote "There seems to be a badly delimited field in here.  Are entry and field delimiters set correctly?"
  828.         goto $begPos
  829.         error "Can't find close brace"
  830.         } else {
  831.         set endPos [nextLineStart $pos1]
  832.         }
  833.     }
  834.     return [list $begPos $endPos]
  835. }
  836.  
  837. ###########################################################################
  838. #  Advance to the next bibliographic entry.
  839. #
  840. proc nextEntry {} {
  841.     global bibTopPat bibTopPat1 bibTopPat2
  842. #     set topPat {[     ]*@([a-zA-Z]+)[\{\(]}
  843.     
  844.     set pos0 [lindex [getEntry [getPos]] 1]
  845.     set nextPos [nextLineStart $pos0]
  846.     
  847.     while {![catch {search -f 1 -r 1 -s $bibTopPat $pos0} pos]} {
  848.         regexp $bibTopPat [eval getText $pos] mtch type
  849.         if {$type != "string"} {
  850.             set nextPos [lindex $pos 0]
  851.             break
  852.         } else {
  853.             set pos0 [nextLineStart [lindex $pos 1]]
  854.         }
  855.     }
  856.     goto $nextPos
  857. }
  858.  
  859. ###########################################################################
  860. #  Go back to the previous bibliographic entry.
  861. #
  862. proc prevEntry {} {
  863.     global bibTopPat bibTopPat1 bibTopPat2
  864. #     set topPat {[     ]*@([a-zA-Z]+)[\{\(]}
  865.     
  866.     set pos0 [lindex [getEntry [getPos]] 0]
  867.     if {[pos::compare $pos0 > [minPos]]} {
  868.     set nextPos $pos0
  869.         set pos0 [pos::math $pos0 - 1]
  870.     while {![catch {search -f 0 -r 1 -s $bibTopPat $pos0} pos]} {
  871.         regexp $bibTopPat [eval getText $pos] mtch type
  872.         if {$type != "string"} {
  873.         set nextPos [lindex $pos 0]
  874.         break
  875.         } else {
  876.         set pos0 [lineStart [lindex $pos 0]]
  877.         if {[pos::compare $pos0 == [minPos]]} {break}
  878.         set pos0 [pos::math $pos0 - 1]
  879.         }
  880.     }
  881.     goto $nextPos
  882.     }
  883. }
  884.  
  885. ###########################################################################
  886. #  Select (highlight) the current bibliographic entry.
  887. #
  888. proc selectEntry {} {
  889.     set pos [getEntry [getPos]]
  890.     select [lindex $pos 0] [lindex $pos 1]
  891. }
  892.  
  893. ###########################################################################
  894. #  Put the cite-key of the current entry on the clipboard.
  895. #
  896. proc copyCiteKey {} {
  897.     global bibTopPat2
  898.     set limits [getEntry [getPos]]
  899.     set top [lindex $limits 0]
  900.     set bottom [lindex $limits 1]
  901.     if {[regexp -indices $bibTopPat2 [getText $top $bottom] allofit type citekey]} {
  902.     select [pos::math $top + [lindex $citekey 0]] [pos::math $top + [expr [lindex $citekey 1] + 1]]
  903.     copy
  904.     message "Copied \"[getSelect]\""
  905.     } 
  906. }
  907.  
  908. ###########################################################################
  909. #  Create a new bibliographic entry with its required fields.
  910. #
  911. proc newEntry {entryName} {    
  912.     global  entryNames customEntries fieldNames rqdFld optFld myFld defFldVal
  913.     global bibOpenEntry bibCloseEntry BibmodeVars
  914.     goto [lindex [getEntry [getPos]] 1]
  915.     if {$entryName == "customEntry"} {
  916.         set lines "@••$bibOpenEntry••,\r"
  917.         set theFields [listpick -l -L {author} -p "Pick desired fields:" $fieldNames]
  918.     } else {
  919.         set lines "@${entryName}$bibOpenEntry••,\r"
  920.         if {[lsearch -exact $customEntries $entryName] >= 0 && [llength $myFld($entryName)]} {
  921.             set theFields $myFld($entryName)
  922.         } elseif {[lsearch -exact $entryNames $entryName] >= 0} {
  923.             set theFields $rqdFld($entryName)
  924.         } else {
  925.             set theFields {}
  926.         }
  927.     }
  928.     set nmlen 0
  929.     foreach field $theFields {
  930.         set len [string length $field]
  931.         if {$len > $nmlen} {set nmlen $len}        
  932.     }
  933.     set theTop [lineStart [getPos]]
  934.     foreach field $theFields {
  935.         catch {append lines [newField $field $nmlen]}
  936.     }
  937.     append lines "$bibCloseEntry\r"
  938.     elec::Insertion $lines
  939. }
  940.  
  941. ###########################################################################
  942. #  Create a new field within the current bibliographic entry
  943. #
  944. proc newField {fieldName {nmlen 0}} {    
  945.     global fieldNames useBrace bibOpenQuote bibCloseQuote bibIndent
  946.     global fieldDefs defFldVal
  947.     set spc "                   "
  948.     if {[lsearch -exact $fieldNames $fieldName] >= 0} {
  949.         set needBraces $useBrace($fieldName)
  950.     } else {
  951.         set needBraces 1
  952.     }
  953.     
  954.     if {[lsearch -exact $fieldDefs $fieldName] >= 0} {
  955.         set val $defFldVal($fieldName)
  956.     } else {
  957.         set val "••"
  958.     }
  959.     
  960.     if {$nmlen} {
  961.         set pad [string range $spc 1 [expr $nmlen - [string length $fieldName]]]
  962.     } else {
  963.         set pad ""
  964.     }            
  965.     if {$needBraces || $fieldName == "customField"} {
  966.         set result "$bibIndent$fieldName =$pad ${bibOpenQuote}${val}${bibCloseQuote},\r"
  967.     } else {
  968.         set result "$bibIndent$fieldName =$pad $val,\r"
  969.     }    
  970.     return $result
  971. }
  972.  
  973. proc bibFormatSetup {} {
  974.     global bibOpenQuote bibCloseQuote bibIndent BibmodeVars
  975.     global bibOpenEntry bibCloseEntry bibAbbrevs
  976.     bibFieldDelims
  977.     bibEntryDelims
  978.     set bibIndent $BibmodeVars(indentString)
  979.     regsub {\\t} $bibIndent {    } bibIndent
  980.     set bibAbbrevs [listStrings]
  981.     foreach abbrev $BibmodeVars(stdAbbrevs) {
  982.         lappend bibAbbrevs [string tolower $abbrev]
  983.     }
  984. }
  985.  
  986. ###########################################################################
  987. #  Find all entries that match a given regular expression and copy them to 
  988. #  a new buffer.
  989. #
  990. proc searchEntries {} {
  991.     if [catch {prompt "Regular expression:" ""} reg] return
  992.     if {![string length $reg]} return
  993.     set reg ^.*$reg.*$
  994.     
  995.     set matches [findEntries $reg]
  996.     if {[llength $matches] >0} {
  997.         writeEntries $matches 0
  998.     } else {
  999.         message "No matching entries were found"
  1000.     }
  1001. }
  1002.  
  1003. ###########################################################################
  1004. #  Find all entries in which the indicated field matches a given regular 
  1005. #  expression and copy them to a new buffer.  
  1006. #
  1007. proc searchFields {} {
  1008.     global fieldNames
  1009.     if {[catch {eval prompt {{Field name:}} "author" {Fields} $fieldNames} fld]} return
  1010.     if {![string length $fld]} return
  1011.  
  1012.     if {[catch {prompt "Regular expression:" ""} reg]} return
  1013.     if {![string length $reg]} return
  1014.  
  1015.     set matches [findEntries $reg]
  1016.     if {[llength $matches] == 0} {
  1017.         return "No matching entries were found"
  1018.     }
  1019.     
  1020.     set vals {}
  1021.     foreach hit $matches {
  1022.         set pos [lindex $hit 1]
  1023.         set top [lindex $hit 2] 
  1024.         set bottom [lindex $hit 3]
  1025.         while {[set failure [expr {[getFldName $pos $top] != $fld}]]  && 
  1026.         ![catch {search -f 1 -r 1 -i 1 -m 0 -l $bottom -s -- $reg $pos} mtch]} {
  1027.             set pos [lindex $mtch 1]
  1028.         }
  1029.         if {!$failure} { lappend vals [list $top $bottom] }
  1030.     }
  1031.     
  1032.     if {[llength $vals] >0} {
  1033.         writeEntries $vals 0
  1034.     } else {
  1035.         message "No matching entries were found"
  1036.     }
  1037.     
  1038. }
  1039.  
  1040. ###########################################################################
  1041. # Sort all of the entries based on one of various criteria.
  1042. #
  1043. proc bibSortProc {menu item} {
  1044.     if {$item == "citeKey"} {
  1045.         sortByCiteKey
  1046.     } elseif  {$item == "firstAuthor,Year"} {
  1047.         sortByAuthors 0 0
  1048.     } elseif  {$item == "lastAuthor,Year"} {
  1049.         sortByAuthors 1 0
  1050.     } elseif  {$item == "year,FirstAuthor"} {
  1051.         sortByAuthors 0 1
  1052.     } elseif  {$item == "year,LastAuthor"} {
  1053.         sortByAuthors 1 1
  1054.     }
  1055. }
  1056.  
  1057. ###########################################################################
  1058. # Sort the file marks. (These operations are also available under the
  1059. # "Search:NamedMarks" menu)
  1060. #
  1061. proc markSortProc {menu item} {
  1062.     if {$item == "alphabetically"} {
  1063.         sortMarksFile
  1064.     } elseif  {$item == "byPosition"} {
  1065.         orderMarks
  1066.     }
  1067. }
  1068.  
  1069. ###########################################################################
  1070. # Sort all of the entries in the file alphabetically by author.
  1071. #
  1072. proc sortByAuthors {{lastAuthorFirst 0} {yearFirst 0}} {
  1073.     global bibTopPat bibTopPat1 bibTopPat2 BibmodeVars
  1074.     set bibSegStr $BibmodeVars(segregateStrings)
  1075.     
  1076.     set matches [findEntries $bibTopPat]
  1077.     set crossrefs [listCrossrefs]
  1078.     set strings [listStrings]
  1079.     
  1080.     set vals {}
  1081.     set others {}
  1082.     set refs {}
  1083.     set strs {}
  1084.     
  1085.     set beg [maxPos]
  1086.     set end [minPos]
  1087.     
  1088.     foreach hit $matches {
  1089.         set pos [lindex $hit 1]
  1090.         set top [lindex $hit 2] 
  1091.         set bottom [lindex $hit 3]
  1092.         set entry [getText $top $bottom]
  1093.         regsub -all "\[\n\r\]+" $entry { } entry
  1094.         regsub -all "\[     \]\[     \]+" $entry { } entry
  1095.         regsub {[,     ]*[\)\}][     ]*$} $entry { } entry
  1096.         if {[regexp $bibTopPat1 $entry allofit citeKey]} {
  1097.             set citeKey [string tolower $citeKey]
  1098.             set keyExists 1
  1099.         } else {
  1100.             set citekey ""
  1101.             set keyExists 0
  1102.         }
  1103.         
  1104.         if {$keyExists && [lsearch -exact $crossrefs $citeKey] >= 0} {
  1105.             lappend refs [list $pos $top $bottom]
  1106.         } elseif {$bibSegStr && $keyExists && [lsearch -exact $strings $citeKey] >= 0} {
  1107.             lappend strs [list $citeKey $top $bottom]        
  1108.         } else {
  1109.             if {![catch {getFldValue $entry author} fldval]} {
  1110.                 if {[catch {getFldValue $entry year} year]} { set year 9999 }
  1111.                 lappend vals [list [authSortKey $fldval $lastAuthorFirst $year $yearFirst] $top $bottom]
  1112.             } else {
  1113.                 lappend others [list $pos $top $bottom]
  1114.             }
  1115.         }
  1116.         if {[pos::compare $top < $beg]} {set beg $top}
  1117.         if {[pos::compare $bottom > $end]} {set end $bottom}
  1118.     }
  1119.     
  1120.     if {$bibSegStr} {
  1121.         set result [concat $strs $others [lsort $vals] $refs]
  1122.     } else {
  1123.         set result [concat $others [lsort $vals] $refs]
  1124.     }
  1125.     
  1126.     if {[llength $result] >0} {
  1127.         writeEntries $result 1 $beg $end
  1128.     } else {
  1129.         message "No results of author sort !!??"
  1130.     }
  1131. }
  1132.  
  1133. ###########################################################################
  1134. # Return a list of the cite-keys of all cross-referenced entries.
  1135. #
  1136. proc listStrings {} {
  1137.     global bibTopPat bibTopPat1 bibTopPat2
  1138.     set matches [findEntries {^[    ]*@string *[\{\(]} 0]
  1139.  
  1140.     message "scanning for @strings…"
  1141.     foreach hit $matches {
  1142.         set top [lindex $hit 2] 
  1143.         set bottom [lindex $hit 3]
  1144.         set entry [getText $top $bottom]
  1145.         regsub -all "\[\n\r\]+" $entry { } entry
  1146.         regsub -all "\[     \]\[     \]+" $entry { } entry
  1147.         regsub {[,     ]*[\)\}][     ]*$} $entry { } entry
  1148.         regexp $bibTopPat1 $entry allofit citekey
  1149.         set citekey [string tolower $citekey]
  1150.         if {[catch {incr strings($citekey)} num]} {
  1151.             set strings($citekey) 1
  1152.         }
  1153.     }
  1154.     if {[catch {lsort [array names strings]} res]} {
  1155.         set res {}
  1156.     }
  1157.     message ""
  1158.     return $res
  1159. }
  1160.  
  1161. ###########################################################################
  1162. # Return a list of the cite-keys of all cross-referenced entries.
  1163. #
  1164. proc listCrossrefs {} {
  1165.     set matches [findEntries {crossref}]
  1166.     catch {unset crossrefs}
  1167.  
  1168.     message "scanning for crossrefs…"
  1169.     foreach hit $matches {
  1170.         set top [lindex $hit 2] 
  1171.         set bottom [lindex $hit 3]
  1172.         set entry [getText $top $bottom]
  1173.         regsub -all "\[\n\r\]+" $entry { } entry
  1174.         regsub -all "\[     \]\[     \]+" $entry { } entry
  1175.         regsub {[,     ]*[\)\}][     ]*$} $entry { } entry
  1176.         if {![catch {getFldValue $entry crossref} fldval]} {
  1177.             set fldval [string tolower $fldval]
  1178.             if {[catch {incr crossref($fldval)} num]} {
  1179.                 set crossrefs($fldval) 1
  1180.             }
  1181.         }
  1182.     }
  1183.     if {[catch {lsort [array names crossrefs]} res]} {
  1184.         set res {}
  1185.     }
  1186.     message ""
  1187.     return $res
  1188. }
  1189.  
  1190. ###########################################################################
  1191. # Create a sort key from an author list.  When sorting entries by author, 
  1192. # performing the sort using keys should be faster than reparsing the author 
  1193. # lists for every comparison (the old method :-( ).
  1194. #
  1195. proc authSortKey {authList lastAuthorFirst {year {}} {yearFirst 0}} {
  1196.     global BibmodeVars
  1197.     set pat1 {\\.\{([A-Za-z])\}}
  1198.     set pat2 {\{([^\{\}]+) ([^\{\}]+)\}}
  1199.  
  1200. # Remove enclosing braces, quotes, or whitespace
  1201.     set auths %[string trim $authList {{}"     }]&
  1202. # Remove TeX codes for accented characters
  1203.     regsub -all $pat1 $auths {\1} auths
  1204. # Concatenate strings enclosed in braces
  1205.     while {[regsub -all $pat2 $auths {{\1\2}} auths]} {}
  1206. # Remove braces (curly and square)
  1207.     regsub -all {[][\{\}]} $auths {} auths
  1208. #    regsub -all {,} $auths { ,} auths
  1209. # Replace 'and's with begin-name/end-name delimiters
  1210.     regsub -all {[     ]and[     ]} $auths { \&% } auths
  1211. # Put last name first in name fields without commas
  1212.     regsub -all {%([^\&,]+) ([^\&, ]+) *\&} $auths {%\2,\1\&} auths
  1213. # Remove begin-name delimiters
  1214.     regsub -all {%} $auths {} auths
  1215. # Remove whitespace surrounding name separators
  1216.     regsub -all {[     ]*\&[     ]*} $auths {\&} auths
  1217. # Replace whitespace separating words with shrieks 
  1218.     regsub -all {[     ,]+} $auths {!} auths
  1219. # If desired, move last author to head of sort key
  1220.     if {$lastAuthorFirst} {
  1221.         regsub {(.*)&([^&]+)&?$} $auths {\2\&\1} auths
  1222.     }
  1223. # If provided, sort by year (descending order) as well
  1224.     regsub {^[^0-9]*([0-9]*).*$} $year {\1} year
  1225.     if {$year != {}} {
  1226.         if {$BibmodeVars(descendingYears)} { catch {set year [expr 9999-$year]} }
  1227.         if {$yearFirst} {
  1228.             set auths "$year&$auths"
  1229.         } else {        
  1230.             regsub {^([^&]+)(&?)} $auths "\\1\\&${year}\\2" auths
  1231.         }
  1232.     }
  1233.         
  1234.     return $auths
  1235. }
  1236.  
  1237. ###########################################################################
  1238. # Sort all of the entries in the file alphabetically by their cite-keys.
  1239. #
  1240. proc sortByCiteKey {} {
  1241.     global bibTopPat bibTopPat1 bibTopPat2 BibmodeVars
  1242.     set bibSegStr $BibmodeVars(segregateStrings)
  1243.     
  1244.     set matches [findEntries $bibTopPat]
  1245.     set crossrefs [listCrossrefs]
  1246.     set strings [listStrings]
  1247.  
  1248.     set begEntries [maxPos]
  1249.     set endEntries [minPos]
  1250.     
  1251.     set strs {}
  1252.     set vals {}
  1253.     set refs {}
  1254.         
  1255.     foreach hit $matches {
  1256.         set beg [lindex $hit 0]
  1257.         set end [lindex $hit 1]
  1258.         set top [lindex $hit 2] 
  1259.         set bottom [lindex $hit 3]
  1260.         if {[regexp $bibTopPat1 [getText $top $bottom] allofit citekey]} {
  1261.             set citekey [string tolower $citekey]
  1262.             set keyExists 1
  1263.         } else {
  1264.             set citekey "000000$beg"
  1265.             set keyExists 0
  1266.         }
  1267.         
  1268.         if {$keyExists && [lsearch -exact $crossrefs $citekey] >= 0} {
  1269.             lappend refs [list $top $top $bottom]
  1270.         } elseif {$keyExists && $bibSegStr && [lsearch -exact $strings $citekey] >= 0} {
  1271.             lappend strs [list $citekey $top $bottom]        
  1272.         } else {
  1273.             lappend vals [list $citekey $top $bottom]
  1274.         }
  1275.  
  1276.         if {[pos::compare $top < $begEntries]} {set begEntries $top}
  1277.         if {[pos::compare $bottom > $endEntries]} {set endEntries $bottom}
  1278.     }
  1279.  
  1280.     if {$bibSegStr} {
  1281.         set result [concat $strs [lsort $vals] $refs]
  1282.     } else {
  1283.         set result [concat [lsort $vals] $refs]
  1284.     }
  1285.     
  1286.     if {[llength $result] >0} {
  1287.         writeEntries $result 1 $begEntries $endEntries
  1288.     } else {
  1289.         message "No results of cite-key sort !!??"
  1290.     }
  1291. }
  1292.  
  1293. ###########################################################################
  1294. # Search for all entries matching a given regular expression.  The results
  1295. # are returned in a list, each element of which is a list of four integers:
  1296. # the beginning and end of the matching entry and the beginning and end of
  1297. # the matching string.  Adapted from "matchingLines" in "misc.tcl".
  1298. #
  1299. proc findEntries {reg {casesen 1}} {
  1300.     if {![string length $reg]} return
  1301.     
  1302.     set pos [minPos]   
  1303.     set result {}                             
  1304.     while {![catch {search -f 1 -r 1 -m 0 -i $casesen -s $reg $pos} mtch]} {
  1305.         set entry [getEntry [lindex $mtch 0]]
  1306.         lappend result [concat $mtch $entry]
  1307.         set pos [lindex $entry 1]
  1308.     }
  1309.     return $result
  1310. }
  1311.  
  1312. ###########################################################################
  1313. #  Return a list containing the data for the current entry, indexed by
  1314. #  the parameter names, e.g., "author", "year", etc.  Index names for the 
  1315. #  entry type and cite-key are "type" and "citekey". 
  1316. #
  1317. proc getFields {pos} {
  1318.      global bibTopPat bibTopPat1 bibTopPat2 bibTopPat3
  1319.     set fldPat {[     ]*([a-zA-Z]+)[     ]*=[     ]*}
  1320.  
  1321.     set limits [getEntry $pos]
  1322.     set top [lindex $limits 0]
  1323.     set bottom [lindex $limits 1]
  1324.     
  1325.     set entry [getText $top $bottom]
  1326.     regsub -all "\[\n\r\]+" $entry { } entry
  1327.     regsub -all "\[     \]\[     \]+" $entry { } entry
  1328. #
  1329.     regsub {[,     ]*[\)\}][     ]*$} $entry { } entry
  1330.  
  1331.     if {[regexp -indices $bibTopPat2 $entry mtch theType theKey ]} {
  1332.         set key [string range $entry [lindex $theKey 0] [lindex $theKey 1]]
  1333.         set theRest [expr 1 + [lindex $mtch 1]]
  1334.     } elseif {[regexp -indices $bibTopPat3 $entry mtch theType aField]} {
  1335.         set key {}
  1336.         set theRest [lindex $aField 0]
  1337.     } else {
  1338.         error "Invalid entry"
  1339.     }
  1340.     lappend names type
  1341.     set type [string tolower [string range $entry [lindex $theType 0] [lindex $theType 1]]]
  1342.     lappend data [list $type]
  1343.  
  1344.     lappend names citekey
  1345.     lappend data $key
  1346.     
  1347.     set entry ",[string range $entry $theRest end]"
  1348.     set fldPat {,[     ]*([^ =,]+)[     ]*=[     ]*}
  1349.     set name {}
  1350.     while {[regexp -indices $fldPat $entry mtch sub1]} {
  1351.         set nextName [string range $entry [lindex $sub1 0] [lindex $sub1 1]]
  1352.         lappend names [string tolower $nextName]
  1353.         if {$name != ""} { 
  1354.             set prevData [string range $entry 0 [expr [lindex $mtch 0]-1]]
  1355.             lappend data [breakIntoLines [bibFieldData $prevData]]
  1356.         }    
  1357.         set name $nextName
  1358.         set entry [string range $entry [expr [lindex $mtch 1]+1] end]
  1359.     }
  1360.  
  1361.     lappend data [breakIntoLines [bibFieldData $entry]]
  1362.     
  1363.     return [list $names $data]
  1364. }
  1365.  
  1366. proc bibFieldData {text} {
  1367.     set text [string trim $text {     ,#}]
  1368.     set text1 [string trim $text {\{\}\"     }]            
  1369.     
  1370.     if {[string match {*[\{\}\"]*} $text1]} {
  1371.         set words [parseWords $text]
  1372.         if {[llength $words]==1} {
  1373.             regsub {^[\{\"\']} $text {} text
  1374.             regsub {[\}\"\']$} $text {} text
  1375.         }
  1376.     } else {
  1377.         set text $text1            
  1378.     }
  1379.     return $text
  1380. }
  1381.  
  1382.  
  1383. ###########################################################################
  1384. # Extract the data from the indicated field of an entry, which is passed 
  1385. # as a single string.  This version tries to be completely general, 
  1386. # allowing nested braces within data fields and ignoring escaped 
  1387. # delimiters.  (derived from proc getField).
  1388. #
  1389. proc getFldValue {entry fldname} {
  1390.     set fldPat "\[     \]*${fldname}\[     \]*=\[     \]*"
  1391.     set fldPat2 {,[     ]*([^ =,]+)[     ]*=[     ]*}
  1392.     set slash "\\"
  1393.     set qslash "\\\\"
  1394.     
  1395.     set ok [regexp -indices -nocase $fldPat $entry mtch]
  1396.     if {$ok} {
  1397.         set pos [expr [lindex $mtch 1] + 1]
  1398.         set entry [string range $entry $pos end]
  1399.         
  1400.         if {[regexp -indices $fldPat2 $entry mtch sub1]} {
  1401.             set entry [string range $entry 0 [expr [lindex $mtch 0]-1]]
  1402.         } 
  1403.         set fld [bibFieldData $entry]
  1404.         
  1405.         return $fld
  1406.         
  1407.     } else {
  1408.         error "field not found"
  1409.     }
  1410. }
  1411.  
  1412. ###########################################################################
  1413. # Parse the entry around position "pos" and rewrite it to the original 
  1414. # buffer in a canonical format
  1415. #
  1416. proc formatEntry {} {
  1417.     global useBrace bibOpenQuote bibCloseQuote 
  1418.     global bibOpenEntry bibCloseEntry bibIndent
  1419.     set spc "                           "
  1420.     
  1421.     bibFormatSetup
  1422.     
  1423.     set pos [getPos]
  1424.     set limits [getEntry $pos]
  1425.     set top [lindex $limits 0]
  1426.     set bottom [lindex $limits 1]
  1427.     
  1428.     if {![catch {bibFormatEntry $pos} result]} {
  1429.         if {$result != [getText $top $bottom]} {
  1430.             replaceText $top $bottom $result
  1431.         } 
  1432.         goto $top 
  1433.         nextEntry
  1434.     } else {
  1435.         message "Couldn't format this entry for some reason"
  1436.     }
  1437. }
  1438.  
  1439. ###########################################################################
  1440. # Parse the entry around position "pos" and rewrite it to the original 
  1441. # buffer in a canonical format
  1442. #
  1443. proc formatAllEntries {} {
  1444.     global useBrace bibOpenQuote bibCloseQuote 
  1445.     global bibOpenEntry bibCloseEntry bibIndent
  1446.     set spc "                           "
  1447.     
  1448.     bibFormatSetup
  1449.     
  1450.     # This little dance handles the case that the first 
  1451.     # entry starts on the first line
  1452.     #
  1453.     set hit [getEntry [getPos]]
  1454.     if {[pos::compare [lindex $hit 0] == [lindex $hit 1]]} {
  1455.         nextEntry
  1456.         set hit [getEntry [getPos]]
  1457.     }
  1458.     
  1459.     while {[pos::compare [getPos] < [lindex $hit 1]]} {
  1460.         set top [lindex $hit 0] 
  1461.         set bottom [lindex $hit 1]
  1462.         
  1463.         if {![catch {bibFormatEntry $top} result]} {
  1464.             set oldEntry [getText $top $bottom]
  1465.             if {$result != $oldEntry} {
  1466.                 deleteText $top $bottom 
  1467.                 insertText $result
  1468.             } 
  1469.         }
  1470.         goto $top
  1471.         nextEntry
  1472.         set hit [getEntry [getPos]]
  1473.     }
  1474. }
  1475.  
  1476. ###########################################################################
  1477. # Parse the entry around position "pos" and rewrite it in a canonical format.
  1478. # The formatted entry is returned.
  1479. #
  1480. proc bibFormatEntry {pos} {
  1481.     global useBrace bibOpenQuote bibCloseQuote 
  1482.     global bibOpenEntry bibCloseEntry bibIndent
  1483.     global rqdFld optFld BibmodeVars bibAbbrevs
  1484.     set spc "                           "
  1485.     #    
  1486.     #    note: calling proc must call "bibFormatSetup" before calling "bibFormatEntry"
  1487.     #
  1488.     set limits [getEntry $pos]
  1489.     set top [lindex $limits 0]
  1490.     set bottom [lindex $limits 1]
  1491.  
  1492.     if {[catch {getFields $pos} flds]} {
  1493.         error "bibFormatEntry: Getflds couldn't find any"
  1494.     }
  1495.     
  1496.     set names [lindex $flds 0]
  1497.     set vals [lindex $flds 1]
  1498.     set nfld [llength $names]
  1499.     
  1500.     set type [string tolower [lindex $vals 0]]
  1501.     set citekey [lindex $vals 1]
  1502. #     message "$citekey"
  1503.     # Don't process @string entries
  1504.     if {$type == "string"} {
  1505.         set lines [getText $top $bottom]
  1506.         return $lines
  1507.     }
  1508.     # Find length of longest field name
  1509.     set nmlen 0
  1510.     foreach nm $names {
  1511.         set len [string length $nm]
  1512.         if {$len > $nmlen} { set nmlen $len }
  1513.         if {![info exists useBrace($nm)]} { set useBrace($nm) 0 }
  1514.     }
  1515.     
  1516.     # Format first line
  1517.     set lines "@${type}${bibOpenEntry}${citekey},\r"
  1518.     
  1519.     # Format each field on a separate line
  1520.     for {set ifld 2} {$ifld < $nfld} {incr ifld} { 
  1521.         set nm [lindex $names $ifld]
  1522.         set vl [lindex $vals $ifld]
  1523.         if {$vl != "" || ! $BibmodeVars(zapEmptyFields) || 
  1524.                 [lsearch $rqdFld($type) $nm] >= 0} {
  1525.             set pad [expr $nmlen - [string length $nm]]
  1526.             
  1527.             if {$BibmodeVars(alignEquals)} {
  1528.                 set pref "${bibIndent}$nm[string range $spc 1 $pad] ="
  1529.             } else {
  1530.                 set pref "${bibIndent}$nm =[string range $spc 1 $pad]"
  1531.             }
  1532.             set ind [string range $spc 1 [string length $pref]]
  1533.             
  1534.             # Delimit field, if appropriate
  1535.             set noBrace [expr ($useBrace($nm) == 0 && [is::UnsignedInteger $vl]) || [regexp {\#} $vl]]
  1536.             if {$noBrace == 0 && [string first " " $vl] < 0} {
  1537.                 set noBrace [expr [lsearch $bibAbbrevs [string tolower $vl]] >= 0]
  1538.             }
  1539.             if {$noBrace != 0} {
  1540.                 set vl "$vl,"
  1541.             } else {
  1542.                 set vl "${bibOpenQuote}${vl}${bibCloseQuote},"
  1543.             }
  1544.             
  1545.             set pieces [split $vl "\r"]
  1546.             append lines "$pref [lindex $pieces 0]\r"
  1547.             foreach piece [lrange $pieces 1 end] {
  1548.                 append lines "$ind  $piece\r"
  1549.             }
  1550.         }
  1551.     }
  1552.     append lines "$bibCloseEntry\r"
  1553.     return $lines
  1554. }
  1555.  
  1556. ###########################################################################
  1557. # Get the name of the field that starts before the given position,  
  1558. # $pos.  The positions $top and $bottom restrict the range of the 
  1559. # search for the beginning and end of the field; typically, $top and
  1560. # $bottom will be the limits of a given entry.
  1561. #
  1562. proc getFldName {pos top} {
  1563.     set fldPat {[,     ]+([^     =,\{\}\"\']+)[     ]*=[     ]*}
  1564.     if {![catch {search -f 0 -r 1 -m 0 -i 1 -s -limit $top "$fldPat" $pos} mtch]} {
  1565.         set theText [eval getText $mtch]
  1566.         regexp -nocase $fldPat $theText allofit fldnam
  1567.         return $fldnam
  1568.     } else {
  1569.         return {citekey}
  1570.     }
  1571. }
  1572.  
  1573. ###########################################################################
  1574. #  Set the quote characters for quoted fields based on the value of the 
  1575. #  flag $bibUseBrace
  1576. # 
  1577. proc bibFieldDelims {} {
  1578.     global BibmodeVars bibOpenQuote bibCloseQuote
  1579.     if {$BibmodeVars(fieldBraces)} {
  1580.         set bibOpenQuote "{"
  1581.         set bibCloseQuote "}" 
  1582.     } else {
  1583.         set bibOpenQuote {"} 
  1584.         set bibCloseQuote {"} 
  1585.     }
  1586. }
  1587.  
  1588. proc bibEntryDelims {} {
  1589.     global BibmodeVars bibOpenEntry bibCloseEntry
  1590.     if {$BibmodeVars(entryBraces)} {
  1591.         set bibOpenEntry "{"
  1592.         set bibCloseEntry "}" 
  1593.     } else {
  1594.         set bibOpenEntry "("
  1595.         set bibCloseEntry ")"
  1596.     }
  1597. }
  1598.  
  1599. proc isBibFile {} {
  1600.     set fileName [win::Current]   
  1601.     set ext [file extension $fileName]
  1602.     return [string match ".bib" [string tolower $ext]] 
  1603. }
  1604.  
  1605.  
  1606.  
  1607. ###########################################################################
  1608. # Take a list of lists that point to selected entries and copy these into
  1609. # a new window.  The beginning and ending positions for each entry must 
  1610. # be the last two items in each sublist.  The rest of the sublists are
  1611. # ignored.  It is assumed that each sublist has the same number of items.
  1612. #
  1613. proc writeEntries {entryPos nondestructive {beg {0}} {end {-1}}} {
  1614.         global BibmodeVars
  1615.         if {$end < 0} {set end [maxPos]}
  1616.         set llen [expr [llength [lindex $entryPos 0]] - 1]
  1617.         set llen1 [expr $llen-1]
  1618.         foreach entry $entryPos {
  1619.             set limits [lrange $entry $llen1 $llen]
  1620.             append lines [eval getText $limits]
  1621.         }
  1622.         set overwriteOK [expr $nondestructive || ! [isBibFile]]
  1623.         if {$BibmodeVars(overwriteBuffer) && $overwriteOK} {
  1624.             deleteText $beg $end
  1625.             insertText $lines
  1626.             goto $beg
  1627.         } else {
  1628.             set begLines [getText [minPos] [lineStart $beg]]
  1629.             set endLines [getText [nextLineStart $end] [maxPos]]
  1630.             new -n {*BibTeX Sort/Search*} -m Bib
  1631.             insertText $begLines
  1632.             insertText $lines
  1633.             insertText $endLines
  1634.             goto $beg
  1635.             setWinInfo dirty 0
  1636.             catch shrinkWindow
  1637.         }
  1638. }
  1639.  
  1640. ###########################################################################
  1641. # Set a named mark for each entry, using the cite-key name
  1642. #
  1643. proc Bib::MarkFile {} {
  1644.     global BibmodeVars
  1645.      global bibTopPat bibTopPat1 bibTopPat2
  1646.     set pos [minPos]
  1647.     while {![catch {search -f 1 -r 1 -m 0 -i 0 -s $bibTopPat1 $pos} res]} {
  1648.         set start [lindex $res 0]
  1649.         set pos [nextLineStart $start]
  1650.         set text [getText $start $pos]
  1651.         if {[regexp $bibTopPat2 $text mtch type citekey]} {
  1652.             if {[string tolower $type] != "string" || $BibmodeVars(markStrings)} { 
  1653.                 setNamedMark $citekey [lineStart [pos::math $start - 1]] $start $start
  1654.             }
  1655.         }
  1656.     }
  1657. }
  1658.  
  1659. ###########################################################################
  1660. # Report the number of entries of each type
  1661. #
  1662. proc countEntries {} {
  1663.     global entryNames
  1664.      global bibTopPat bibTopPat1 bibTopPat2
  1665.     
  1666.     set pos [minPos]
  1667.     set count 0
  1668.     catch {unset type}
  1669.     
  1670.     while {![catch {search -f 1 -r 1 -m 0 -i 0 -s $bibTopPat $pos} res]} {
  1671.         incr count
  1672.         set start [lindex $res 0]
  1673.         set end [nextLineStart $start]
  1674.         set text [getText $start $end]
  1675.         set lab ""
  1676.         if {[regexp $bibTopPat $text mtch entryType]} {
  1677.             set entryType [string tolower $entryType]
  1678.             if {[catch {incr type($entryType)} num]} {
  1679.                 set type($entryType) 1
  1680.             }
  1681.         }
  1682.         set pos $end
  1683.     }
  1684.     new -n {*BibTeX Statistics*} -m Bib
  1685.     foreach name [lsort [array names type]] {
  1686.         if {$type($name) > 0} {
  1687.             append lines [format "%4.0d  %s\n" $type($name) $name]
  1688.         }
  1689.     }
  1690.     append lines "----  -----------------\n"
  1691.     append lines [format "%4.0d  %s\n" $count "Total entries"]
  1692.     insertText $lines
  1693.     goto [minPos]
  1694.     setWinInfo dirty 0
  1695.     catch {shrinkWindow 1}
  1696. }
  1697. #--------------------------------------------------------------------------
  1698. # command-double-clicking:
  1699. #--------------------------------------------------------------------------
  1700.  
  1701. ###########################################################################
  1702. # In Bib mode, Cmd-double-clicks resolve abbrevs and cross-refs
  1703. #
  1704. proc Bib::DblClick {from to} {
  1705.     global bibTopPat bibTopPat1 bibTopPat2
  1706.     
  1707.     set limits [getEntry $from]
  1708.     set top [lindex $limits 0]
  1709.     set bottom [lindex $limits 1]
  1710.  
  1711.     # Extend selection to largest string that could be an entry reference
  1712.     set text [string trim [eval getText [BibExtendClick $from $to $top $bottom]]]
  1713.     
  1714.     # Get the citekey of current entry, so we can avoid jumping to it    
  1715.     set citekey {}
  1716.     regexp $bibTopPat2 [getText $top $bottom] mtch type citekey ]
  1717.     set fldName [getFldName $from $top]
  1718.  
  1719.     if {[string length $text] == 0 || $text == $citekey || $fldName == $text || 
  1720.         ($fldName == "citekey" && [string tolower $type] != "string")} {
  1721.         message "Command-double-click on abbreviations and crossref arguments"
  1722.         return
  1723.     }
  1724.  
  1725.     # Jump to the mark for the specified citation, if a mark exists...
  1726.     # ...otherwise, do an ordinary search for the cite key
  1727.     pushPosition    
  1728.     set searchPat "$bibTopPat\[     \]*[quote::Regfind $text]\[     ,\}\)\]"
  1729.     if {![catch {search -f 1 -r 1 -i 1 -m 0 $searchPat 0} mtch]} {
  1730.         goto [lindex $mtch 0]
  1731.     } else {
  1732.         popPosition
  1733.         select $from $to
  1734.         if {$fldName == "crossref"} {
  1735.             message "Cross-reference \"$text\" not found"
  1736.         } else {
  1737.             message "Command-double-click on abbreviations and crossref arguments"
  1738.         }
  1739.         return
  1740.     }
  1741.     message "Use Ctl-. to return to original position"
  1742.     return
  1743. }
  1744.  
  1745. # Extend the selection around the initial selection {$from,$to}
  1746. # Extension is restricted to the range {$top,$bottom} (the current entry)
  1747. proc BibExtendClick {from to top bottom} {
  1748.     if {$to == [minPos]} { set to $from }
  1749.     set result [list $from $to]
  1750.     if {![catch {search -f 0 -r 1 -s -m 0 -l $top "\[,\{\]\"\'=" $from} mtch0]} {
  1751.         if {![catch {search -f 1 -r 1 -s -m 0 -l $bottom "\[,\}\]\"\'=" $to} mtch1]} {
  1752.             set from [lindex $mtch0 1]
  1753.             set to [lindex $mtch1 0]
  1754.             # Check for illegal chars embedded in the selection
  1755.             if {[regexp "\[\{\}\]=" [getText $from $to]] == 0} {
  1756.                 set result [list $from $to]
  1757.             }
  1758.         }
  1759.     }
  1760.     return $result
  1761. }
  1762.  
  1763. #===============================================================================
  1764. proc pcite {} {
  1765.     set words [getline "Citation keys" ""]
  1766.     if {![llength $words]} {error "No keys"}
  1767.     
  1768.     set pattern {@}
  1769.     foreach w $words {
  1770.         append pattern "(\[^@\]+$w)"
  1771.     }
  1772.     
  1773.     foreach entry [findEntries $pattern] {
  1774.         set res [getFields [car $entry]]
  1775.         set title [lindex [cadr $res] [lsearch [car $res] "title"]]
  1776.         set citekey [lindex [cadr $res] [lsearch [car $res] "citekey"]]
  1777.         set matches($title) $citekey
  1778.         set where($title) [car $entry]
  1779.     }
  1780.     if {![info exists matches]} {alertnote "No citations"; return}
  1781.     set title [listpick -p "Citation?" [lsort [array names matches]]]
  1782.     putScrap $matches($title)
  1783.     alertnote $matches($title)
  1784.     goto $where($title)
  1785. }
  1786.  
  1787.  
  1788.